home *** CD-ROM | disk | FTP | other *** search
/ Clickx 115 / Clickx 115.iso / software / tools / windows / tails-i386-0.16.iso / live / filesystem.squashfs / usr / lib / perl5 / Sub / Identify.pm next >
Encoding:
Perl POD Document  |  2008-12-09  |  2.5 KB  |  94 lines

  1. package Sub::Identify;
  2.  
  3. use strict;
  4. use Exporter;
  5.  
  6. BEGIN {
  7.     our $VERSION = '0.04';
  8.     our @ISA = ('Exporter');
  9.     our %EXPORT_TAGS = (all => [ our @EXPORT_OK = qw(sub_name stash_name sub_fullname get_code_info) ]);
  10.  
  11.     my $loaded = 0;
  12.     unless ($ENV{PERL_SUB_IDENTIFY_PP}) {
  13.         local $@;
  14.         eval {
  15.             if ($] >= 5.006) {
  16.                 require XSLoader;
  17.                 XSLoader::load(__PACKAGE__, $VERSION);
  18.             }
  19.             else {
  20.                 require DynaLoader;
  21.                 push @ISA, 'DynaLoader';
  22.                 __PACKAGE__->bootstrap($VERSION);
  23.             }
  24.         };
  25.  
  26.         die $@ if $@ && $@ !~ /object version|loadable object/;
  27.  
  28.         $loaded = 1 unless $@;
  29.     }
  30.  
  31.     our $IsPurePerl = !$loaded;
  32.  
  33.     if ($IsPurePerl) {
  34.         require B;
  35.         *get_code_info = sub ($) {
  36.             my ($coderef) = @_;
  37.             ref $coderef or return;
  38.             my $cv = B::svref_2object($coderef);
  39.             $cv->isa('B::CV') or return;
  40.             # bail out if GV is undefined
  41.             $cv->GV->isa('B::SPECIAL') and return;
  42.  
  43.             return ($cv->GV->STASH->NAME, $cv->GV->NAME);
  44.         };
  45.     }
  46. }
  47.  
  48. sub stash_name   ($) { (get_code_info($_[0]))[0] }
  49. sub sub_name     ($) { (get_code_info($_[0]))[1] }
  50. sub sub_fullname ($) { join '::', get_code_info($_[0]) }
  51.  
  52. 1;
  53.  
  54. __END__
  55.  
  56. =head1 NAME
  57.  
  58. Sub::Identify - Retrieve names of code references
  59.  
  60. =head1 SYNOPSIS
  61.  
  62.     use Sub::Identify ':all';
  63.     my $subname = sub_name( $some_coderef );
  64.     my $p = stash_name( $some_coderef );
  65.     my $fully_qualified_name = sub_fullname( $some_coderef );
  66.     defined $subname
  67.     and print "this coderef points to sub $subname in package $p\n";
  68.  
  69. =head1 DESCRIPTION
  70.  
  71. C<Sub::Identify> allows you to retrieve the real name of code references. For
  72. this, it uses perl's introspection mechanism, provided by the C<B> module.
  73.  
  74. It provides four functions : C<sub_name> returns the name of the
  75. subroutine (or C<__ANON__> if it's an anonymous code reference),
  76. C<stash_name> returns its package, and C<sub_fullname> returns the
  77. concatenation of the two.
  78.  
  79. The fourth function, C<get_code_info>, returns a list of two elements,
  80. the package and the subroutine name (in case of you want both and are worried
  81. by the speed.)
  82.  
  83. In case of subroutine aliasing, those functions always return the
  84. original name.
  85.  
  86. =head1 LICENSE
  87.  
  88. (c) Rafael Garcia-Suarez (rgarciasuarez at gmail dot com) 2005, 2008
  89.  
  90. This program is free software; you may redistribute it and/or modify it under
  91. the same terms as Perl itself.
  92.  
  93. =cut
  94.